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-- Flow. mesa last modified by Sweet. July 18, 1978 9:56 AM 

DIRECTORY 

AltoDefs: FROM "altodefs" USING [BYTE, charlength, wordlength]. 

Code: FROM "code" USING [acstack. catchcount, CodeNotlmplemented, codeptr, curctxlvl, f irstcasesel rea 
**d, mwcasesel tlex], 

CodeDefs: FROM "codedefs" USING [BDOIndex, CCNull , ChunkBase, CompareClass. EXLabelRecord, EXLRIndex, 
♦* EXLRNun, FreeChunk, GetChunk, JumpType, LabelCCIndex, Lexeme, topostack], 

ComData: FROM "comdata", 

ControlDefs: FROM "controldef s" USING [localbase, returnOff set] . 

FOpCodes: FROM "fopcodes" USING [qDCOMP, qLL, qLP, qPUSH. qSFC], 

P5ADefs: FROM "pSadefs" USING [adjustacstack, CioutO, Cioutl, Cload, copyBDOItem, Coutjump, Csyscall, 
*♦ Csyscalln, dumpstack, easilyaddressed, freeheaplex, genanonlex, genBDOItem, gentemplex, GetFrame, in 
**crstack, labelalloc, loadlexaddress, loadtsonaddress . loadtsonchars, LogHeapFree, LongTreeAddress, ma 
♦♦rkstack, operandtype, pop, RequireStack, rmakeBDOItem, sCassign, treeliteral, wordsforoperand] . 

P5BDefs: FROM "pSbdefs" USING [Cexp. Cstatement, MWConstant, pushlex, pushlitval, pushrhs], 

P6StmtExprDefs: FROM "p5stmtexprdef s" , 

SDDefs: FROM "sddefs" USING [sBLTE, sBLTEC. sBLTECL. sBLTEL, sBYTBLTE, sBYTBLTEC, sBYTBLTECL, sBYTBLT 
**EL, sFCOMP], 

SymDefs: FROM "symdefs" USING [ContextLevel . CSEIndex, CTXIndex, HTIndex, HTNull, ISEIndex, SEIndex, 
**setype], 

SymTabDefs: FROM "symtabdefs" USING [BitsForType, Cardinality], 

TableDefs: FROM "tabledefs" USING [TableBase, TableLimit, TableNotif ier], 

TreeDefs: FROM "treedefs" USING [empty, NodeName, scanlist, Treelndex, TreeLink, treetype]; 

DEFINITIONS FROM CodeDefs; 

Flow: PROGRAM 

IMPORTS CPtr: Code, CodeDefs, P5ADefs, PSBDefs, TreeDefs, SymTabDefs 

EXPORTS CodeDefs, P5ADefs, PSStmtExprDef s ■ 
BEGIN 
OPEN P5ADefs, P5BDefs; 

-- imported definitions 

BYTE: TYPE - AltoDefs .BYTE; 

wordlength: CARDINAL « AltoDefs .wordlength; 

charlength: CARDINAL = AltoDefs. charlength; 

ContextLevel: TYPE « SymDefs. ContextLevel ; 
CTXIndex: TYPE = SymDefs. CTXIndex; 
HTIndex: TYPE - SymDefs .HTIndex; 
HTNull: HTIndex « SymDef s.HTNul 1 ; 
ISEIndex: TYPE = SymDef s. ISEIndex; 
SEIndex: TYPE « SymDef s .SEIndex; 

empty: TreeLink ■ TreeDefs. empty; 
NodeName: TYPE « TreeDefs. NodeName; 
Treelndex: TYPE - TreeDefs. Treelndex; 
TreeLink: TYPE = TreeDefs. TreeLink; 

CRLabelRecord: TYPE » RECORD [ 
free: BOOLEAN, 

retrylabel, contlabel: LabelCCIndex, 
crcc: CARDINAL]; 

CRLRIndex: TYPE « ChunkBase RELATIVE POINTER [0. .TableDefs .TableLimit) TO CRLabelRecord; 
CRLRNull: CRLRIndex « LOOPHOLE[TableDef s .TableLimit-1] ; 

labelstack: EXLRIndex ^ EXLRNull; 

CRlabel: CRLRIndex ♦- CRLRNull; 

UndeclaredLabel : SIGNAL[HTIndex] » CODE; 

tb: TableDefs. TableBase; — tree base (local copy) 

seb: TableDefs. TableBase; -- semantic entry base (local copy) 

cb: ChunkBase; -~ code base (local copy) 

FlowNotify: PUBLIC TableDefs .TableNotif ier - 

BEGIN -~ called by allocator whenever table area is repacked 

seb <- base[SymDefs.setype]; 

tb <- base[TreeDefs. treetype]; 

cb *- LOOPHOLE[tb]; 

RETURN 

END; 
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JumpNN: PACKED ARRAY NodeName[relE . . relLE] OF JumpType ^ [ 
JumpE, JumpN, JumpL, JumpGE, JumpG» JumpLE]; 

UJumpNN: PACKED ARRAY NodeNanie[relE. , relLE] OF JumpType ^ [ 
JumpE, JumpN, UJumpL, UJumpGE, UJumpG, UJumpLE]; 

RNN: ARRAY NodeName[relE . . rel LE] OF NodeName ■ [ 
relE, relN, relG, relLE. relL, relGE]; 

CNN: ARRAY NodeName[relE . . rel LE] OF NodeName ■ [ 
relN, relE, relGE, relL, relLE. relG]; 

PushOnly: PROCEDURE [t: TreeLink] ■ 
BEGIN 

IF t # empty THEN BEGIN RequireStack[0] ; pushrhs[t] END 
ELSE BEGIN pushrhs[t]; RequireStack[l] END; 
RETURN 
END; 

Cflow: PUBLIC PROCEDURE [t: TreeLink, tf: BOOLEAN, label: LabelCCIndex] 
BEGIN -- produces code to jump to label on condition tf 
node: Treelndex; 
1 : se Lexeme; 
labell: LabelCCIndex; 
sw: BOOLEAN; 

WITH t SELECT FROM 
symbol «> 
BEGIN 

RequireStack[0]; 

1 ♦- Lexeme[lexvalue: se[index]]; 
pushlex[l]; 
pushlitval[0]; 

Coutjump[IF tf THEN JumpN ELSE JumpE, label]; 
RETURN 
END; 
subtree «■> 
BEGIN 

node <r index; 

SELECT (tb+node).name FROM 
and, or »> 

BEGIN ENABLE LogHeapFree «> RESUME[FALSE, topostack]; 
sw <- IF (tb+node),name » and THEN tf ELSE -tf; 
IF sw THEN 
BEGIN 

labell<-labelallocC]; 
Cflow[(tb+node).sonl, -tf, labell]; 
Cflow[(tb+node).son2, tf, label]; 
insertlabel[labell]; 
END 
ELSE 
BEGIN 

Cflow[(tb+node).sonl. tf, label]; 
Cflow[(tb+node).son2, tf, label]; 
END; 
END; 
not «> Cflow[(tb+node) .sonl, ~tf, label]; 
in -> Cfin[t, tf, label]; 
notin «> Cfin[t, -tf, label]; 
relE, relN, relL, relGE, relG, relLE •> 

sCfrel[node. tf, label]; 
ENDCASE -> 
BEGIN 

PushOnly[t]; 
pushl itval[0]; 

Coutjump[IF tf THEN JumpN ELSE JumpE, label]; 
END; 
END; 
ENDCASE; 
RETURN 
END; 

CompareOps: ARRAY Compared ass OF ARRAY BOOLEAN OF 

PACKED ARRAY [1..2] OF BYTE ^ -- try to make this better ♦♦*♦♦♦*♦* 
[[[SDDef s . sBLTE . SODef s . sBLTEL] , 
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[SDDef s . sBLTEC , SDDef s . sBLTECL]] . 
[ [SDDef s . sBYTBLTE , SDDef s . sBYTBLTEL] . 
[SDDef s . sBYTBLTEC , SDDef s . sBYTBLTECL]]] ; 

CompareFn: PUBLIC PROCEDURE [class: CompareClass, code: BOOLEAN, length: [1..2]] RETURNS [BYTE] 
BEGIN 

RETURN[CompareOps[ class] [code] [length]]; 
END; 

sCfrel: PROCEDURE [node: Treelndex. tf: BOOLEAN, label: LabelCCIndex] ■ 
BEGIN -- main subroutine of Cflow for handling relationals 
tl: TreeLink ^ (tb+node) .sonl; 
t2, tt: TreeLink; 
sei: SymDefs.CSEIndex; 
n: NodeName <- (tb+node) .name; 
nwords: INTEGER; 

lexl, lex2: se Lexeme <- topostack; 
tlex: se Lexeme; 
function: CompareClass <- word; 
plength: [1..2]; 
code: BOOLEAN *- FALSE; 
real: BOOLEAN; 
tladdrsize, t2addrsize: CARDINAL; 

IF treeliteral[tl] THEN 

BEGIN 

n 4- RNN[n]; 

t2 <r tl; tl *- (tb+node). son2; 

END 
ELSE t2 ^ (tb+node). son2; 
IF ~tf THEN n ^ CNN[n]; 

BEGIN 

IF tZ.tag » literal THEN GO TO notpacked; 
sei <- operandtype[t2]; 
WITH (seb+sei) SELECT FROM 
array ■> 
BEGIN 

IF ^packed OR SymTabDef s.Bi tsForType[componenttype] > 8 THEN GO TO notpacked; 
nwords ^ SymTabDef s .Cardinal ity[indextype]; 
IF nwords <- 4 THEN 
BEGIN 

IF tl ^ empty THEN RequireStack[0]; 
loadtsonchars[tl, nwords]; 

IF tl « empty THEN RequireStack[(nwords+l)/2]; 
loadtsonchars[t2, nwords]; 

IF nwords <» 2 THEN Cout jump[UJumpNN[n]. label] 
ELSE 
BEGIN 

CioutO[FOpCodes.qDCOMP]; 
pushlitval[0]; 
Coutjump[JumpNN[n] , label]; 
END; 
RETURN 
END 
ELSE function *- byte; 
END; 
ENDCASE -> GO TO notpacked; 
EXITS 

notpacked -> nwords ^ wordsforoperand[t2]; 
END; 
IF nwords > 1 THEN 
BEGIN 

IF nwords - 2 THEN 
BEGIN 

RequireStack[0]; 

IF (real ♦- (tb+node) .attrl AND (tb+node) .attr2) THEN markstack[]; 
IF tl - empty THEN 
BEGIN 

CPtr.f irstcaseselread<-FALSE; 
pushlex[CPtr.mwcaseseltlex] 
END 
ELSE pushrhs[tl]; 
RequireStack[2]; 
pushrhs[t2]; 
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IF real THEN Csyscalln[SDDef s.sFCOMP.l] ELSE CioutO[FOpCodes.qDCOMP] ; 
pushlitval[0]; 
Coutjump[JumpNN[n], label]; 
RETURN 
END; 
clumpstack[]; niarkstack[]; 
WITH tl SELECT FROM 
subtree ■> 

IF (tb+index).name ■ mwconst THEN 
BEGIN tt ^ tl; tl ♦- t2; t2 <- tt END; 
ENDCASE; 
WITH tl SELECT FROM 
subtree ■> 

IF (tb+index),name ■ mwconst THEN SIGNAL CPtr .CodeNotlmplemented; 
ENDCASE; 
tladdrsize ^ IF tl - empty THEN loadlexaddress[CPtr.mwcasesel tlex] 
ELSE loadtsonaddress[tl 

ILogHeapFree ■> IF calltree ■ tl THEN RESUME[TRUE. lexl ^ genanonlex[l]] 

]; 

IF tladdrsize » wordlength AND LongTreeAddress[t2] THEN 

CioutO[FOpCodes.qLP]; 
push! itval[nwords]; 
t2addrsize ♦- loadtsonaddress[t2 
ILogHeapFree ■> 

IF calltree - t2 THEN RESUME[TRUE. Iex2 ^ genanonlex[l]]; 
MWConstant ■> 
BEGIN 

code <- TRUE; 
pushlitval[cOffset]; 
t2addrsize <- tladdrsize; 
CONTINUE; 
END 

3; 

IF tladdrsize f^ t2addrsize THEN 
BEGIN 

IF tladdrsize > wordlength THEN CioutO[FOpCodes.qLP]; 
plength *- 2; 
END 
ELSE plength ^ tladdrsize/wordlength; 
Csyscan[CompareFn[f unction , code, plength]]; 
incrstack[l]; CPtr.acstack <- 1; 
IF lexl # topostack OR lex2 # topostack THEN 
BEGIN 

tlex <- gentemplex[l]; 
sCassign[tlex.lexsei]; 

IF lexl # topostack THEN f reeheaplex[lexl]; 
IF lex2 # topostack THEN f reeheaplex[lex2]; 
pushlex[tlex]; 
END; 
pushlitval[0]; 

Coutjump[IF n # relE THEN JumpE ELSE JumpN. label]; 
RETURN 
END; 
PushOnly[tl]; 
pushrhs[t2]; 

CoutjumptIF (tb+node).attr2 THEN UJumpNN[n] ELSE JumpNN[n], label]; 
RETURN 
END; 

Cfin: PUBLIC PROCEDURE [t: TreeLink, tf: BOOLEAN, label: LabelCCIndex] - 
BEGIN -- generates code for IN expression in flow context 
node: Treelndex; 
n: NodeName; 

1: LabelCCIndex ^ labelalloc[]; 

jumpNN: POINTER TO PACKED ARRAY NodeName[relE . .relLE] OF JumpType; 
double, real: BOOLEAN; 
r: BDOIndex; 
tl: TreeLink; 
tlex: se Lexeme; 

WITH t SELECT FROM 
subtree ■> 
BEGIN 

node *- index; 
tl ♦- (tb+node).sonl; 
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double ^ (tb+node) .attrl; 
IF double THEN 
BEGIN 

RequireStack[0]; 

IF (real <- double AND (tb+node) .attrZ) THEN markstack[]; 
IF tl - empty THEN 
BEGIN 

CPtr.f irstcaseselread^-FALSE; 
pushlex[CPtr.mwcaseseltlex]; 
r ♦■ rmakeBDOItem[CPtr.mwcaseseltlex]; 
END 
ELSE 
BEGIN 

r *- rmakeBDOItem[Cexp[tl]]; 
IF -easilyaddressed[r] THEN 
BEGIN 
Cload[r]; 

tlex ♦" gentemplex[2]; 
sCassign[tlex.lexsei]; 
r ♦- rmakeBDOItem[tlex]; 
END; 
Cload[copyBDOItem[r]]; 
END; 
END 
ELSE PushOnly[tl]; 
WITH (tb+node). son2 SELECT FROM 
subtree ■> 

BEGIN ENABLE LogHeapFree -> RESUME[FALSE, topostack]; 
node *- index; 

jumpNN ^ IF -double AND (tb+node) .attr2 THEN @UOumpNN ELSE @JumpNN; 
n ♦- (tb+node) .name; 
pushrhs[( tb+node) .sonl]; 
IF double THEN 
BEGIN 

IF real THEN Csyscalln[SDDef s .sFCOMP»l] 
ELSE CioutO[FOpCodes.qDCOMP]; 
pushlitval[0]; 
END; 
SELECT n FROM 

intOO.intOC »> Coutjump[jumpNN[relLE] .IF tf THEN 1 ELSE label]; 
intCO.intCC »> Coutjump[jumpNN[relL] . IF tf THEN 1 ELSE label]; 
ENDCASE; 
IF double THEN 
BEGIN 

IF real THEN markstack[]; 
Cload[r]; 
END 
ELSE CioutO[FOpCodes.qPUSH]; 
pushrhs[( tb+node) .son2]; 
IF double THEN 
BEGIN 

IF real THEN Csyscal ln[SDDef s .sFCOMP. 1] 
ELSE CioutO[FOpCodes.qDCOMP]; 
pushlitval[0]; 
END; 
SELECT n FROM 

intOO.intCO »> Coutjump[IF tf THEN jumpNN[relL] ELSE jumpNN[relGE] . label ]; 
intOC.intCC «=> CoutjumpflF tf THEN jumpNN[relLE] ELSE jumpNN[relG] . label]; 
ENDCASE; 
insertlabel[l]; 
RETURN 
END; 
ENDCASE 
END; 
ENDCASE 
END; 

Ccatchmark: PUBLIC PROCEDURE [node: Treelndex] ■ 
BEGIN -- process a CONTINUEd or RETRYed statement 
savCRlabel: CRLRIndex <- CRlabel; 

1: CRLRIndex ^ CodeDefs .GetChunk[SIZE[CRLabel Record]]; 
elabel: LabelCCIndex; 

CRlabel ^ 1; 
cb[l].free «- FALSE; 
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insertlabel[cb[l].retry1abel ♦- 1abelanoc[]]; 

elabel ^ cb[l].cont1abel ^ labe1anoc[]; 

cb[1].crcc <- CPtr.catchcount; 

(tb+node) .sonl ^ Cstatement[(tb+node) .sonl]; 

insert1abe1[e1abe1]; 

CRlabel ♦- savCRlabel ; 

CodeDefs.FreeChunk[1 , SIZE[CRLabe1Record]]; 

RETURN 

END; 



Clabel: PUBLIC PROCEDURE [node: .Treelndex] ■ 
BEGIN -- process an exitable block 
elabel: LabelCCIndex <- labelalloc[]; 
labelmark: EXLRIndex <- labelstack; 

TreeDefs.scanlist[( tb+node) .son2, CI abel create]; 

(tb+node) .sonl +- Cstatement[(tb+node) .sonl]; 

Coutjump[Jump, elabel]; 

CI abenist[( tb+node) .son2, elabel]; 

insertlabel[elabel]; 

pop 1 abel s[ labelmark]; 

RETURN 

END; 



getlabelmark: PUBLIC PROCEDURE RETURNS [EXLRIndex] 
BEGIN RETURN[labelstack] END; 



poplabels: PUBLIC PROCEDURE [labelmark: EXLRIndex] 
BEGIN 
oldl: EXLRIndex; 

UNTIL labelstack « labelmark DO 

oldl <- labelstack; 

labelstack <- cb[labelstack] .thread; 

CodeDefs.FreeChunk[oldl , SIZE[EXLabelRecord]] ; 

ENDLOOP; 
RETURN 
END; 



Clabellist: PUBLIC PROCEDURE [t: TreeLink. elabel: LabelCCIndex] 
BEGIN -- generates code for labels 
Clabelitem: PROCEDURE [t: TreeLink] - 
BEGIN -- generates code for a label item 
WITH t SELECT FROM 
subtree ■> 
BEGIN 

TreeDefs. scan list[(tb+index). sonl, put! abel]; 
(tb+index) .son2 ♦- Cstatement[(tb+index) .son2]; 
Coutjump[Jump, elabel]; 
RETURN 
END; 
ENDCASE 
END; 

TreeDefs. scanlist[t, Clabelitem]; 

RETURN 

END; 



putlabel: PROCEDURE [t: TreeLink] - 
BEGIN 
WITH t SELECT FROM 

hash -> insertlabel[cb[f indlabel[index]]. labelcci]; 

ENDCASE; 
RETURN 
END; 



Clabelcreate: PUBLIC PROCEDURE [t: TreeLink] 
BEGIN -- sets up label cells for labels , 
WITH t SELECT FROM 
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subtree ■> TreeDefs.scanI ist[(tb+1ndex) .sonl, pushlabel]; 

ENDCASE; 
RETURN 
END; 

pushlabel: PROCEDURE [t: TreeLink] ■ 

BEGIN -- stacks a label for an EXIT clause 

1: EXLRIndex <- CodeDefs.GetChunk[SIZE[EXLabelRecord]]; 

WITH t SELECT FROM 
hash "> 
BEGIN 
cb[l] 4- 

EXLabelRecord[free: FALSE, thread: labelstack, labelhti: index, 
label cc: CPtr.catchcount, labeled: labelallocC]]; 
labelstack ^ 1 ; 
RETURN; 
END; 
ENDCASE 
END; 

makeEXITlabel: PUBLIC PROCEDURE RETURNS [exit, loop: LabelCCIndex] ■ 
BEGIN -- sets up anonymous label for EXITs 
1: EXLRIndex <- CodeDef s .GetChunk[SIZE[EXLabelRecord]]; 

exit ^ labelalloc[]; 
loop <- labelalloc[3; 
cb[l] ♦- 

EXLabelRecord[free: FALSE, thread: labelstack. labelhti: HTNull. 
labelcc: CPtr.catchcount, labelcci: loop]; 
labelstack ^ 1 * 

1 ♦- CodeDefs.GetChunk[SIZE[EXLabelRecord]]; 
cb[l] ^ 

EXLabelRecord[free: FALSE, thread: labelstack, labelhti: HTNull. 
labelcc: CPtr.catchcount. labelcci: exit]; 
labelstack ♦• 1 ; 
RETURN 
END; 

findlabel: PROCEDURE [hti: HTIndex] RETURNS [c: EXLRIndex] - 
BEGIN -- searches down label stack for label hti 
FOR c *- labelstack. cb[c]. thread UNTIL c « EXLRNull DO 

IF cb[c]. labelhti - hti THEN RETURN 

ENDLOOP; 
SIGNAL UndeclaredLabel[hti]; 
RETURN 
END; 

Cretry: PUBLIC PROCEDURE ■ 

BEGIN -- process RETRY statement 

retcontexit[cb[CRlabel].crcc, cb[CRlabel] . ret ry label]; 
RETURN 
END; 

Ccontinue: PUBLIC PROCEDURE - 

BEGIN -- process CONTINUE statement 
retcontexit[cb[CRlabel].crcc, cb[CRl abel ] .contlabel]; 
RETURN 
END; 

Cexit: PUBLIC PROCEDURE - 

BEGIN -- generate code for EXIT 
1: EXLRIndex *- f indlabel[HTNull ]; 

retcontexit[cb[l]. labelcc, cb[l]. labelcci]; 

RETURN 

END; 

Cloop: PUBLIC PROCEDURE - 

BEGIN -- generate code for EXIT 
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1: EXLRIndex <r f indlabel[HTNu11]; 



1 *- cb[1]. thread; 

retcontexit[cb[1]. label cc, cb[l].labelcci]; 

RETURN 

END; 



Cgoto: PUBLIC PROCEDURE [node: Treelndex] ■ 
BEGIN -- generate code for GOTO 
1: EXLRIndex; 

WITH (tb+node).sonl SELECT FROM 

hash ■> 1 ♦" f indlabel[index]; 

ENDCASE; 
retcontexit[cb[l]. label cc. cb[l]. labeled]; 
RETURN 
END; 



retcontexit: PROCEDURE [cc: CARDINAL. Ic: LabelCCIndex] - 
BEGIN -- process EXIT/REPEAT statement 
r: BDOIndex; 

IF CPtr.catchcount ■ cc THEN Coutjump[Jump, Ic] 
ELSE 

BEGIN 

markstack[]; 

r ^ genBDOItem[]; 

cb[r].tag ^ o; 

cb[r]. offset <- 

[level : CPtr.curctxl vl-(CPtr.catchcount-cc-l) , 
posn:[wd: ControlDef s. localbase, bd: 0], 
size: Al toDef s .wordlength]; 

GetFrame[r]; 

pushlex[[bdo[r]]]; 

pushl itval[-l]; 

Cioutl[FOpCodes.qLL, ControlDef s. ret urnOff set]; 

CioutO[FOpCodes.qSFC]; 

adjustacstack[-2]; 

pop[]; pop[]; 

CoutJump[Jump, Ic]; 

END; 
RETURN 
END; 



insertlabel: PUBLIC PROCEDURE [c: LabelCCIndex] - 
BEGIN -- puts a label chunk in the code stream 
IF CPtr.codeptr # CCNull THEN 

BEGIN 

cb[c].flink <- cb[CPtr.codeptr] .fl ink; 

IF cb[CPtr.codeptr].flink ^ CCNull THEN 
cb[cb[CPtr.codeptr].flink]. blink ♦- c; 

cb[CPtr.codeptr].f link ♦- c; 

END 
ELSE cb[c].flink ♦- CCNull; 
cb[c]. blink *- CPtr.codeptr; 
CPtr.codeptr *• c; 
RETURN 
END; 



END... 



